home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
TARCHIV.ZIP
/
GADGETS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-01-27
|
4KB
|
233 lines
{************************************************}
{ }
{ }
{************************************************}
unit Gadgets;
{$F+,O+,S-,D-}
{ Useful gadgets: clock,heap,number,text viewer }
interface
uses Dos, Objects, Views, App;
type
PHeapView = ^THeapView;
THeapView = object(TView)
OldMem : LongInt;
constructor Init(var Bounds: TRect);
procedure Draw; virtual;
procedure Update;
end;
PNumView = ^TNumView;
TNumView = object(TView)
OldNum : Word;
constructor Init(var Bounds: TRect);
procedure Draw; virtual;
procedure Update (NewNum : Word);
end;
PFlagView = ^TFlagView;
TFlagView = object(TView)
OldFlag : Boolean;
constructor Init(var Bounds: TRect);
procedure Draw; virtual;
procedure Update (NewFlag : Boolean);
end;
PTextView = ^TTextView;
TTextView = object(TView)
OldText : String;
constructor Init(var Bounds: TRect);
procedure Draw; virtual;
procedure Update (NewText : String);
end;
PClockView = ^TClockView;
TClockView = object(TView)
Refresh: Byte;
LastTime: DateTime;
TimeStr: string[16];
constructor Init(var Bounds: TRect);
procedure Draw; virtual;
function FormatTimeStr(H, M, S: Word): String; virtual;
procedure Update; virtual;
end;
implementation
uses Drivers;
{------ Heap Window object ----------}
constructor THeapView.Init(var Bounds: TRect);
begin
TView.Init(Bounds);
OldMem := 0;
end;
procedure THeapView.Draw;
var
S: String;
B: TDrawBuffer;
C: Byte;
begin
OldMem := MemAvail;
Str(OldMem:Size.X, S);
C := GetColor(2);
MoveChar(B, ' ', C, Size.X);
MoveStr(B, S, C);
WriteLine(0, 0, Size.X, 1, B);
end;
procedure THeapView.Update;
begin
if (OldMem <> MemAvail) then DrawView;
end;
{ ---- Number viewer --- }
constructor TNumView.Init(var Bounds: TRect);
begin
TView.Init(Bounds);
OldNum := 0;
end;
procedure TNumView.Draw;
var
S: String;
B: TDrawBuffer;
C: Byte;
begin
Str(OldNum:Size.X, S);
C := GetColor(2);
MoveChar(B, ' ', C, Size.X);
MoveStr(B, S, C);
WriteLine(0, 0, Size.X, 1, B);
end;
procedure TNumView.Update (NewNum : Word);
begin
If NewNum<>OldNum Then Begin
OldNum := NewNum;
DrawView;
End;
end;
{ ---- Text viewer --- }
constructor TTextView.Init(var Bounds: TRect);
begin
TView.Init(Bounds);
OldText := '';
end;
procedure TTextView.Draw;
var
B: TDrawBuffer;
C: Byte;
begin
C := GetColor(2);
MoveChar(B, ' ', C, Size.X);
MoveStr(B, OldText, C);
WriteLine(0, 0, Size.X, 1, B);
end;
procedure TTextView.Update (NewText : String);
begin
If NewText<>OldText Then Begin
OldText := NewText;
DrawView;
End;
end;
{ ---- Flag viewer --- }
constructor TFlagView.Init(var Bounds: TRect);
begin
TView.Init(Bounds);
OldFlag := False;
end;
procedure TFlagView.Draw;
var
S: String;
B: TDrawBuffer;
C: Byte;
begin
If OldFlag Then S:='(√)' Else S:='( )';
C := GetColor(2);
MoveChar(B, ' ', C, Size.X);
MoveStr(B, S, C);
WriteLine(0, 0, Size.X, 1, B);
end;
procedure TFlagView.Update (NewFlag : Boolean);
begin
If NewFlag<>OldFlag Then Begin
OldFlag := NewFlag;
DrawView;
End;
end;
{-------- ClockView Object --------}
function LeadingZero(w: Word): String;
var s: String;
begin
Str(w:0, s);
LeadingZero := Copy('00', 1, 2 - Length(s)) + s;
end;
constructor TClockView.Init(var Bounds: TRect);
begin
TView.Init(Bounds);
FillChar(LastTime, SizeOf(LastTime), #$FF);
TimeStr := '';
Refresh := 1;
end;
procedure TClockView.Draw;
var
B: TDrawBuffer;
C: Byte;
begin
C := GetColor(2);
MoveChar(B, ' ', C, Size.X);
MoveStr(B, TimeStr, C);
WriteLine(0, 0, Size.X, 1, B);
end;
procedure TClockView.Update;
var
h,m,s,hund: word;
begin
GetTime(h,m,s,hund);
if Abs(s - LastTime.sec) >= Refresh then
begin
with LastTime do
begin
Hour := h;
Min := m;
Sec := s;
end;
TimeStr := FormatTimeStr(h, m, s);
DrawView;
end;
end;
function TClockView.FormatTimeStr(H, M, S: Word): String;
begin
FormatTimeStr := LeadingZero(h)+ ':'+ LeadingZero(m) +
':' + LeadingZero(s);
end;
end.